home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-11-30 | 4.6 KB | 176 lines | [TEXT/ttxt] |
- --<<<
- format debug "-- Compiling Slider Class . . .\n" undefined undefined
-
- class Slider(GroupPresenter)
- inst vars
- id
- thumb
- track
- minY
- maxY
- minValue
- maxValue
- currentValue
- connectedObject
- notifyMethod
- --Event Interests
- mouseDown
- mouseUp
- mouseMove
- mouseLeaving
- end
-
- method init self {class slider} #rest args #key castNum: lingo: dirInfo:->
- (
- apply nextMethod self args
- local castList := dirInfo[@cast]
- self.id := findSXKey(lingo, "id")
- print castlist[castNum] --debug
- local track := (new TwoDShape boundary:castlist[castNum].boundary)
- if track = empty do (
- format debug "Slider castNum: %*\n" castNum @unadorned
- report GeneralError "problem with castNum parameter"
- )
- prepend self track
- self.track := track
- local thumbCast := castFromName(findSXKey(lingo, "thumb"))
- format debug "thumbCast = %*\n" thumbCast @unadorned --debug
- local thumbBmp := thumbCast.boundary
- format debug "thumbBmp = %*\n" thumbBmp @unadorned --debug
- thumbBmp.matteColor := whiteColor
- local thumb := (new TwoDShape boundary:thumbBmp)
- if thumb <> empty do (
- prepend self thumb
- self.thumb := thumb
- local tHt := thumb.height
- local myRect := self.bbox
- self.minY := myRect.y1 + tHt
- self.maxY := myRect.y2 - tHt
- )
- self.minValue := -50
- self.maxValue := 50
- self.currentValue := 0
- self.connectedObject := self.notifyMethod := undefined
- return self
- )
-
- method mouseDownAction self {class Slider} theInterest theEvent ->
- (
- local addInterset := (e -> if not e.advertised do addEventInterest e)
- addInterset self.mouseMove
- -- addInterset self.mouseUp
- -- addInterset self.mouseLeaving
- )
-
- method mouseUpAction self {class Slider} theInterest theEvent ->
- (
- local disconn := ( myInterest -> if myInterest.advertised do removeEventInterest myInterest)
- disconn self.mouseMove
- -- disconn self.mouseUp
- -- disconn self.mouseLeaving
- )
-
- method mouseMoveAction self {class Slider} theInterest theEvent ->
- (
- local newY := theEvent.localCoords.y
- local minY := self.minY
- local maxY := self.maxY
- if newY < minY do newY := minY
- if newY > self.maxY do newY := maxY
- if newY <> self.currentValue do (
- self.thumb.y := newY
- notifyChanged self true
- local minY := self.minY
- local maxY := self.maxY
- local minValue := self.minValue
- local maxValue := self.maxValue
- local Ypct := (maxY - newY) / (maxY - minY)
- local newVal := minValue + ((maxValue - minValue)*Ypct)
- self.currentValue := newVal
- local connObj := self.connectedObject
- if connObj <> undefined do (
- self.notifyMethod connObj newVal
- )
- )
- )
-
- method setCurrValue self {class Slider} value ->
- (
- self.currentValue := value
- local minY := self.minY
- local maxY := self.maxY
- local minValue := self.minValue
- local maxValue := self.maxValue
- local valpct := value / (maxValue - minValue)
- local newY := (minY + ((maxY - minY)*valpct)) as integer
- self.thumb.y := newY
- notifyChanged self true
- )
-
- method connect self {class Slider} #rest args #key values:(#(-100,100)) target: changeMethod:->
- (
- self.connectedObject := target
- self.notifyMethod := changeMethod
- self.minValue := values[1]
- self.maxValue := values[2]
- )
-
- method hook self {class Slider}->
- (
- local mdEvnt := self.mouseDown
- if not (isAKindOf mdEvnt MouseDownEvent) do (
- mdEvnt := new MouseDownEvent
- mdEvnt.eventReceiver := mouseDownAction
- mdEvnt.authorData := self
- mdEvnt.device := new MouseDevice
- mdEvnt.presenter := self.thumb
- self.mouseDown := mdEvnt
- )
- addEventInterest mdEvnt
-
- local muEvent := self.mouseUp
- if not (isAKindOf muEvent MouseUpEvent) do (
- muEvent := new MouseUpEvent
- muEvent.eventReceiver := mouseUpAction
- muEvent.authorData := self
- muEvent.device := mdEvnt.device
- muEvent.presenter := self.presentedBy
- muEvent.matchedInterest := mdEvnt
- self.mouseUp := muEvent
- )
- addEventInterest muEvent
-
- local mmEvent := self.mouseMove
- if not (isAKindOf mmEvent MouseMoveEvent) do (
- mmEvent := new MouseMoveEvent
- mmEvent.eventReceiver := mouseMoveAction
- mmEvent.authorData := self
- mmEvent.device := mdEvnt.device
- mmEvent.presenter := self
- mmEvent.matchedInterest := mdEvnt
- self.mouseMove := mmEvent
- )
- local mlEvent := self.mouseLeaving
-
- if not (isAKindOf mmEvent MouseCrossingEvent) do (
- mlEvent := new MouseCrossingEvent
- mlEvent.eventReceiver := mouseUpAction
- mlEvent.authorData := self
- mlEvent.device := mdEvnt.device
- mlEvent.presenter := self
- self.mouseLeaving := mlEvent
- )
- addEventInterest mlEvent
- )
-
- method unhook self {class Slider}->
- (
- local disconn := ( myInterest -> if myInterest.advertised do removeEventInterest myInterest)
- disconn self.mouseUp
- disconn self.mouseDown
- disconn self.mouseMove
- )
-
- #(Slider, #("id"),#("hook","unhook","connect"))
- -->>>
-